home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / cust.frg < prev    next >
Encoding:
Text File  |  1993-03-09  |  7.1 KB  |  369 lines
  1. * Program............: cust.FRG
  2. * Date...............: 3-09-93
  3. * Versions...........: dBASE IV, Report 2.0
  4. *
  5. * Notes:
  6. * ------
  7. * Prior to running this procedure with the DO command
  8. * it is necessary use LOCATE because the CONTINUE
  9. * statement is in the main loop.
  10. *
  11. *-- Parameters
  12. PARAMETERS gl_noeject, gl_plain, gl_summary, gc_heading, gc_extra
  13. ** The first three parameters are of type Logical.
  14. ** The fourth parameter is a string.  The fifth is extra.
  15. PRIVATE _peject, _wrap, ll_heading
  16. ll_heading = .F.
  17.  
  18. *-- Test for no records found
  19. IF EOF() .OR. .NOT. FOUND()
  20.    RETURN
  21. ENDIF
  22.  
  23. *-- turn word wrap mode off
  24. _wrap=.F.
  25.  
  26. IF _plength < (_pspacing * 3 + 1) + (_pspacing + 1) + 2
  27.    SET DEVICE TO SCREEN
  28.    DEFINE WINDOW gw_report FROM 7,17 TO 11,62 DOUBLE
  29.    ACTIVATE WINDOW gw_report
  30.    @ 0,1 SAY "Increase the page length for this report."
  31.    @ 2,1 SAY "Press any key ..."
  32.    x=INKEY(0)
  33.    DEACTIVATE WINDOW gw_report
  34.    RELEASE WINDOW gw_report
  35.    RETURN
  36. ENDIF
  37.  
  38. _plineno=0          && set lines to zero
  39. *-- NOEJECT parameter
  40. IF gl_noeject
  41.    IF _peject="BEFORE"
  42.       _peject="NONE"
  43.    ENDIF
  44.    IF _peject="BOTH"
  45.       _peject="AFTER"
  46.    ENDIF
  47. ENDIF
  48.  
  49. *-- Set-up environment
  50. ON ESCAPE DO Prnabort
  51. IF SET("TALK")="ON"
  52.    SET TALK OFF
  53.    gc_talk="ON"
  54. ELSE
  55.    gc_talk="OFF"
  56. ENDIF
  57. gc_space=SET("SPACE")
  58. SET SPACE OFF
  59. gc_time=TIME()      && system time for predefined field
  60. gd_date=DATE()      && system date  "    "    "     "
  61. gl_fandl=.F.        && first and last page flag
  62. gl_prntflg=.T.      && Continue printing flag
  63. gl_widow=.T.        && flag for checking widow bands
  64. gn_length=LEN(gc_heading)  && store length of the HEADING
  65. gn_level=2          && current band being processed
  66. gn_page=_pageno     && grab current page number
  67. gn_pspace=_pspacing && get current print spacing
  68.  
  69. *-- Initialize group footer field variables
  70. r_foot1=.F.
  71.  
  72.  
  73. *-- Set up procedure for page break
  74. gn_atline=_plength - (_pspacing + 1)
  75. ON PAGE AT LINE gn_atline EJECT PAGE
  76.  
  77. *-- Print Report
  78.  
  79. PRINTJOB
  80.  
  81. *-- Initialize group break vars.
  82. r_mvar4=CATEGORY
  83.  
  84. *-- Initialize summary variables.
  85. cust_cnt=0
  86. r_msum1=0
  87.  
  88. IF gl_plain
  89.    ON PAGE AT LINE gn_atline DO Pgplain
  90. ELSE
  91.    ON PAGE AT LINE gn_atline DO Pgfoot
  92. ENDIF
  93.  
  94. DO Pghead
  95.  
  96. gl_fandl=.T.        && first physical page started
  97.  
  98. DO Rintro
  99.  
  100. DO Grphead
  101.  
  102. *-- File Loop
  103. DO WHILE FOUND() .AND. .NOT. EOF() .AND. gl_prntflg
  104.    DO CASE
  105.    CASE CATEGORY <> r_mvar4
  106.       gn_level=4
  107.    OTHERWISE
  108.       gn_level=0
  109.    ENDCASE
  110.    *-- test whether an expression didn't match
  111.    IF gn_level <> 0
  112.       DO Grpfoot WITH 100-gn_level
  113.       DO Grpinit
  114.    ENDIF
  115.    *-- Repeat group intros
  116.    IF gn_level <> 0
  117.       DO Grphead
  118.    ENDIF
  119.    gn_level=0
  120.    *-- Detail lines
  121.    IF gl_summary
  122.       DO Upd_Vars
  123.    ELSE
  124.       DO __Detail
  125.    ENDIF
  126.    gl_widow=.T.         && enable widow checking
  127.    CONTINUE
  128. ENDDO
  129.  
  130. IF gl_prntflg
  131.    gn_level=3
  132.    DO Grpfoot WITH 97
  133.    DO Rsumm
  134.    IF _plineno <= gn_atline
  135.       EJECT PAGE
  136.    ENDIF
  137. ELSE
  138.    gn_level=3
  139.    DO Rsumm
  140.    DO Reset
  141.    RETURN
  142. ENDIF
  143.  
  144. ON PAGE
  145.  
  146. ENDPRINTJOB
  147.  
  148. DO Reset
  149. RETURN
  150. * EOP: cust.FRG
  151.  
  152. *-- Determine height of group bands and detail band for widow checking
  153. FUNCTION Gheight
  154. PARAMETER Group_Band
  155. retval=0              && return value
  156. IF Group_Band <= 4
  157.    retval = retval + 2 * gn_pspace
  158. ENDIF
  159. *-- add height of detail band
  160. retval = retval + 8 * gn_pspace
  161. RETURN retval
  162. * EOP: Gheight
  163.  
  164. *-- Update summary fields and/or calculated fields.
  165. PROCEDURE Upd_Vars
  166. r_foot1=Category
  167. *-- Count
  168. cust_cnt=cust_cnt+1
  169. *-- Count
  170. r_msum1=r_msum1+1
  171. RETURN
  172. * EOP: Upd_Vars
  173.  
  174. *-- Set flag to get out of DO WHILE loop when escape is pressed.
  175. PROCEDURE Prnabort
  176. gl_prntflg=.F.
  177. RETURN
  178. * EOP: Prnabort
  179.  
  180. *-- Reset group break variables.  Reinit summary
  181. *-- fields with reset set to a particular group band.
  182. PROCEDURE Grpinit
  183. IF gn_level <= 4
  184.    cust_cnt=0
  185. ENDIF
  186. IF gn_level <= 4
  187.    r_mvar4=CATEGORY
  188. ENDIF
  189. RETURN
  190. * EOP: Grpinit
  191.  
  192. *-- Process Group Intro bands during group breaks
  193. PROCEDURE Grphead
  194. IF EOF()
  195.    RETURN
  196. ENDIF
  197. PRIVATE _pspacing
  198. _pspacing=gn_pspace
  199. IF gn_level = 0
  200.    gn_level=50
  201. ENDIF
  202. IF gn_level = 4
  203.    IF 2 * gn_pspace  < gn_atline
  204.       IF (gl_widow .AND. _plineno+Gheight(4) > gn_atline + 1) ;
  205.       .OR. (gl_widow .AND. _plineno+2 * gn_pspace > gn_atline)
  206.          EJECT PAGE
  207.       ENDIF
  208.    ENDIF
  209. ENDIF
  210. IF gn_level <= 4
  211.    DO Head4
  212. ENDIF
  213. gn_level=0
  214. RETURN
  215. * EOP: Grphead.PRG
  216.  
  217. *-- Process Group Summary bands during group breaks
  218. PROCEDURE Grpfoot
  219. PARAMETER ln_level
  220. IF ln_level >= 96
  221.    DO Foot96
  222. ENDIF
  223. RETURN
  224. * EOP: Grpfoot.PRG
  225.  
  226. PROCEDURE Pghead
  227. ?? IIF(gl_plain,'',gd_date) AT 0,;
  228.  IIF(gl_plain,'' , "PAGE " ) AT 71,;
  229.  IIF(gl_plain,'',_pageno) PICTURE "999" 
  230. ?
  231. ?
  232. ?
  233. RETURN
  234. * EOP: Pghead
  235.  
  236. PROCEDURE Rintro
  237. ?
  238. DEFINE BOX FROM 26 TO 55 HEIGHT 4 DOUBLE
  239. ?
  240. ?? "A-T FURNITURE INDUSTRIES" STYLE "B" AT 29
  241. ?
  242. ?? "CUSTOMER REPORT" STYLE "B" AT 33
  243. ?
  244. ?
  245. ?
  246. ?
  247. RETURN
  248. * EOP: Rintro
  249.  
  250. PROCEDURE Head4
  251. IF gn_level=1
  252.    RETURN
  253. ENDIF
  254. ?? ;
  255. "══════════════════════════════════════════════════════════════════════";
  256. + "═════════";
  257. AT 0
  258. ?
  259. ?? "CATEGORY:" STYLE "BU" AT 0,;
  260.  Category FUNCTION "T" STYLE "BU" AT 10
  261. ?
  262. RETURN
  263.  
  264. PROCEDURE __Detail
  265. IF 8 * gn_pspace < gn_atline - (_pspacing * 3 + 1)
  266.    IF gl_widow .AND. _plineno+8 * gn_pspace > gn_atline + 1
  267.       EJECT PAGE
  268.    ENDIF
  269. ENDIF
  270. DO Upd_Vars
  271. ?? "I.D.: " AT 0,;
  272.  Cust_id FUNCTION "T" PICTURE "!XXXXX" 
  273. ?
  274. ?? Customer FUNCTION "T" AT 0,;
  275.  Phone FUNCTION "T" PICTURE "(XXX)XXX-XXXX" AT 46
  276. ?
  277. ?? Address1 FUNCTION "T" AT 0,;
  278.  " " ,;
  279.  Address2 FUNCTION "T" 
  280. ?
  281. ?? City FUNCTION "T" AT 0,;
  282.  ", " ,;
  283.  State FUNCTION "T" ,;
  284.  " " ,;
  285.  Zip FUNCTION "T" 
  286. ?
  287. ?? "CONTACT:" AT 0,;
  288.  Contact FUNCTION "T" AT 9,;
  289.  Phone_cont FUNCTION "T" PICTURE "(XXX)XXX-XXXX" AT 46,;
  290.  "EXT." AT 62,;
  291.  Phone_ext FUNCTION "T" AT 67
  292. ?
  293. ?? "DATE OF LAST CONTACT: " AT 0,;
  294.  Date_last 
  295. ?
  296. ?? Comments FUNCTION "T" AT 0
  297. ?
  298. ?
  299. RETURN
  300. * EOP: __Detail
  301.  
  302. PROCEDURE Foot96
  303. ?? "NUMBER OF CUSTOMERS IN " AT 0,;
  304.  r_foot1 FUNCTION "T" ,;
  305.  ": " ,;
  306.  cust_cnt PICTURE "9999" 
  307. ?
  308. ?
  309. RETURN
  310.  
  311. PROCEDURE Rsumm
  312. ?
  313. ?? ;
  314. "══════════════════════════════════════════════════════════════════════";
  315. + "═════════";
  316. AT 0
  317. ?
  318. ?? "TOTAL NUMBER OF CUSTOMERS: " AT 0,;
  319.  r_msum1 PICTURE "9999" 
  320. ?
  321. ?? ;
  322. "══════════════════════════════════════════════════════════════════════";
  323. + "═════════";
  324. AT 0
  325. gl_fandl=.F.        && last page finished
  326. ?
  327. RETURN
  328. * EOP: Rsumm
  329.  
  330. PROCEDURE Pgfoot
  331. PRIVATE _box, _pspacing
  332. gl_widow=.F.         && disable widow checking
  333. _pspacing=1
  334. ?
  335. IF .NOT. gl_plain
  336.    _pspacing=gn_pspace
  337.    ?? " PREPARED BY SALES DEPARTMENT" AT 25
  338. ENDIF
  339. EJECT PAGE
  340. *-- is the page number greater than the ending page
  341. IF _pageno > _pepage
  342.    GOTO BOTTOM
  343.    SKIP
  344.    gn_level=0
  345. ENDIF
  346. IF .NOT. gl_plain .AND. gl_fandl
  347.    _pspacing=gn_pspace
  348.    DO Pghead
  349. ENDIF
  350. RETURN
  351. * EOP: Pgfoot
  352.  
  353. *-- Process page break when PLAIN option is used.
  354. PROCEDURE Pgplain
  355. PRIVATE _box
  356. EJECT PAGE
  357. RETURN
  358. * EOP: Pgplain
  359.  
  360. *-- Reset dBASE environment prior to calling report
  361. PROCEDURE Reset
  362. SET SPACE &gc_space.
  363. SET TALK &gc_talk.
  364. ON ESCAPE
  365. ON PAGE
  366. RETURN
  367. * EOP: Reset
  368.  
  369.